home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
TPUG - Toronto PET Users Group
/
TPUG Users Group CD
/
TPUG Users Group CD.iso
/
MSDOS
/
(m)aas
/
WHATIS.ARC
/
WHAT.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1985-11-21
|
6KB
|
190 lines
Program What;
(* This program manages a file called WHAT.DAT, that contains short
descriptions of what programs and files are for. It uses the DOS
command buffer for obtaining program information, then searches
the what.dat file for all matches. *)
Var
Search:string[12];
Yep,Command:char;
What_File:Text;
Search_Data,
What_Text:String[60];
Line:string[80];
Found,stop:Boolean;
Const
What_File_Name='\what.dat';
Spaces = ' ';
(********************************************************************)
Procedure Parse;
(* This procedure reads the command line for program information. If the
command is print or open, the procedure returns immediately. If it is
anything else, it will look for a filename. The command is returned in
the char variable COMMAND, and the filename is returned in the string
SEARCH. *)
Var I:Integer;
Begin
Search:='';
If ParamCount = 0 then begin stop:=True; Exit; End;
Command:=Upcase(copy(ParamStr(1),1,1));
If (ParamCount < 2) then
Begin
If not(Command in ['P','O']) then
Stop:=True;
End
Else
For I:= 1 to length(Paramstr(2)) do
Search:=Concat(Search,Upcase(Copy(Paramstr(2),I,1)));
End;
(****************************************************************************)
Procedure Open_File;
Begin
Reset(What_File);
End;
(****************************************************************************)
Procedure Close_File;
Begin
Close(What_File);
End;
(****************************************************************************)
Procedure Find;
(* This routine searches WHAT.DAT for the next occurance of SEARCH
if it is found, the FOUND flag is set true, otherwise it is set
false. *)
Begin (* Find *)
Found := False;
While (Not Found) and (Not EOF(What_File)) do
Begin (* While Structure *)
Readln(What_File,Line);
If (Copy(Line,1,length(Search))) = Search then
Found:= True;
End; (* While structure *)
End; (* Find *)
(*************************************************************************)
Procedure Is;
Begin
Open_File;
Find;
If Found then
Begin
Writeln;
Writeln(Line);
While (not EOF(What_File)) do
Begin
Find;
if found then Writeln(Line);
End;
End
Else
Writeln(Search, ' was not in WHAT.DAT file.');
Close_File;
End;
(****************************************************************************)
Procedure Enter_New;
Begin
Open_File;
Find;
Close_File;
If found then
Begin (* File Found *)
Writeln('File already exists:');
Writeln(Line);
Exit;
End; (* File Found *)
Repeat
Writeln('Describe ',search,' in 60 characters or less');
Writeln('|--------1---------2---------3---------4---------5---------|');
Readln(What_Text);
Writeln;
Writeln(Search,copy(spaces,1,(13-length(search))),'- ',What_Text);
Writeln;
Write('Is this correct (Y/N/Q)? ');
Repeat
Read(kbd,Yep);
Yep:=Upcase(Yep);
Until (Yep in ['Y','N','Q']);Writeln(Yep);
If Yep = 'Q' then Exit;
Until Yep = 'Y';
Append(What_File);
Writeln(What_File,Search,copy(spaces,1,(13-length(search))),'- ',What_Text);
Close_File;
End;
(****************************************************************************)
Procedure Open_New;
Begin
Writeln('Create new data file. Old data file will be overwritten.');
Write('ARE YOU SURE? (Y/N) ');
Repeat
Read(kbd,Yep);
Yep:=Upcase(Yep);
Until (Yep in ['Y','N']);Writeln(Yep);
If Yep <> 'Y' then exit;
Rewrite(What_File);
Close_File;
Writeln('New WHAT.DAT file has been created in the root directory.');
End;
(****************************************************************************)
Procedure Print_File;
Begin
Write('Print WHAT.DAT to the printer. ARE YOU SURE? (Y/N) ');
Repeat
Read(kbd,Yep);
Yep:=Upcase(Yep);
Until (Yep in ['Y','N']);Writeln(Yep);
If Yep <> 'Y' then exit;
Open_File;
Write('Printing File.....',^m);
Repeat
Readln(What_File,Line);
Writeln(Lst,Line);
Until eof(What_File);
Writeln('Printing Completed');
Close_File;
End;
(****************************************************************************)
Procedure Explain;
Begin
Writeln (^g,'WHAT (c) 1985 by Kevin Ross V1.3 11/21/1985');
Writeln;
Writeln ('What Syntax:');
Writeln (' WHAT OPEN (* opens new WHAT.DAT file *)');
Writeln (' WHAT NEW filename.ext (* adds data to file *)');
Writeln (' WHAT IS filename.ext (* Searchs for first match *)');
Writeln (' WHAT PRINT (* Sends all data to printer *)');
Writeln ;
End;
(****************************************************************************)
Begin
Stop:=false;
Assign(What_File,What_File_Name);
Parse;
If stop or (Not(Command in ['P','O','I','N'])) then
explain
Else
Case Command of
'P' : Print_File;
'O' : Open_New;
'I' : Is;
'N' : Enter_New;
End;
End.